Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue61/Alfresco/AACache.pas

Pascal/Delphi Source File | 2000-08-08 | 16.4 KB | 533 lines

{*********************************************************}
{* AACache                                               *}
{* Copyright (c) Julian M Bucknall 2000                  *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco: Browser file cache class         *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AACache;

interface

uses
  Windows,
  SysUtils,
  Classes,
  AABufStm,
  AAHshLnP,
  AAPriQue;

type
  TaaFileCache = class
    private
      FCurDiskSize   : integer;
      FFolder        : string;
      FItems         : TaaHashTableLinear;
      FExpiryQueue   : TaaPriorityQueueEx;
      FLastUsedQueue : TaaPriorityQueueEx;
      FMaxDiskSize   : integer;
    protected
      procedure fcSetFolder(const aName : string);

      function fcAddItem(aCacheItem : pointer) : boolean;
      procedure fcCleanUp;
      function fcGetQualifiedFileName(const aFileName : string) : string;
      function fcGetUniqueFileName : string;

      procedure fcLoadFromFile;
      procedure fcLoadFromStream(aStream : TStream);
      procedure fcSaveToFile;
      procedure fcSaveToStream(aStream : TStream);
    public
      constructor Create;
      destructor Destroy; override;

      procedure Add(const aExternalName : string;
                    const aExpiryDate   : TDateTime;
                          aStream       : TStream);

      procedure Clear;

      procedure Delete(const aExternalName : string);

      function Get(const aExternalName : string) : TStream;
      procedure GetComplete(const aExternalName : string);

      property Folder : string read FFolder write fcSetFolder;
      property MaxDiskSize : integer read FMaxDiskSize write FMaxDiskSize;
  end;

implementation

const
  CacheFileName = 'AACACHE.IDX';

{===TCacheItem=======================================================}
type
  TCacheItem = class
    private
      FDataStream     : TStream;
      FDownloadDate   : TDateTime;
      FExpiryDate     : TDateTime;
      FExpiryHandle   : TaaPQHandle;
      FExternalName   : string;
      FInternalName   : string;
      FLastUsedDate   : TDateTime;
      FLastUsedHandle : TaaPQHandle;
      FSize           : longint;
    protected
    public
      constructor Create(const aInternalName : string;
                         const aExternalName : string;
                               aExpiryDate   : TDateTime;
                               aDownloadDate : TDateTime;
                               aSize         : longint);
      constructor LoadFromStream(aStream : TStream);
      destructor Destroy; override;

      procedure Use;

      procedure SaveToStream(aStream : TStream);

      property DownloadDate : TDateTime read FDownloadDate;
      property ExpiryDate : TDateTime read FExpiryDate;
      property ExternalName : string read FExternalName;
      property InternalName : string read FInternalName;
      property LastUsedDate : TDateTime read FLastUsedDate;
      property Size : longint read FSize;

      property ExpiryHandle : TaaPQHandle
                  read FExpiryHandle write FExpiryHandle;
      property LastUsedHandle : TaaPQHandle
                  read FLastUsedHandle write FLastUsedHandle;
      property DataStream : TStream read FDataStream write FDataStream;
  end;
{--------}
constructor TCacheItem.Create(const aInternalName : string;
                              const aExternalName : string;
                                    aExpiryDate   : TDateTime;
                                    aDownloadDate : TDateTime;
                                    aSize         : longint);
begin
  inherited Create;
  {set internal fields}
  FInternalName := aInternalName;
  FExternalName := aExternalName;
  if (aExpiryDate = 0.0) then
    FExpiryDate := FDownloadDate + 7.0
  else
    FExpiryDate := aExpiryDate;
  FDownloadDate := aDownloadDate;
  FSize := aSize;
  {set the lastused date}
  FLastUsedDate := Now;
end;
{--------}
constructor TCacheItem.LoadFromStream(aStream : TStream);
var
  Len : integer;
begin
  inherited Create;
  {read in the internal name}
  aStream.ReadBuffer(Len, sizeof(Len));
  SetLength(FInternalName, Len);
  aStream.ReadBuffer(FInternalName[1], Len);
  {read in the extternal name}
  aStream.ReadBuffer(Len, sizeof(Len));
  SetLength(FExternalName, Len);
  aStream.ReadBuffer(FExternalName[1], Len);
  {read in the dates}
  aStream.ReadBuffer(FDownloadDate, sizeof(TDateTime));
  aStream.ReadBuffer(FExpiryDate, sizeof(TDateTime));
  aStream.ReadBuffer(FLastUsedDate, sizeof(TDateTime));
  {read in the size of the file}
  aStream.ReadBuffer(FSize, sizeof(FSize));
end;
{--------}
destructor TCacheItem.Destroy;
begin
  inherited Destroy;
end;
{--------}
procedure TCacheItem.SaveToStream(aStream : TStream);
var
  Len : integer;
begin
  {write out the internal name}
  Len := length(FInternalName);
  aStream.WriteBuffer(Len, sizeof(Len));
  aStream.WriteBuffer(FInternalName[1], Len);
  {write out the external name}
  Len := length(FExternalName);
  aStream.WriteBuffer(Len, sizeof(Len));
  aStream.WriteBuffer(FExternalName[1], Len);
  {write out the dates}
  aStream.WriteBuffer(FDownloadDate, sizeof(TDateTime));
  aStream.WriteBuffer(FExpiryDate, sizeof(TDateTime));
  aStream.WriteBuffer(FLastUsedDate, sizeof(TDateTime));
  {write out the size of the file}
  aStream.WriteBuffer(FSize, sizeof(FSize));
end;
{--------}
procedure TCacheItem.Use;
begin
  FLastUsedDate := Now;
end;
{====================================================================}


{===Helper routines for the cache====================================}
function CompareExpiryDates(const aItem1, aItem2 : pointer) : integer;
var
  CacheItem1 : TCacheItem;
  CacheItem2 : TCacheItem;
begin
  {note: this reverses the usual sense of the comparison so that the
         smallest expiry date (ie the earliest) is retrieved first}
  CacheItem1 := TCacheItem(aItem1);
  CacheItem2 := TCacheItem(aItem2);
  if (CacheItem1.ExpiryDate < CacheItem2.ExpiryDate) then
    Result := 1
  else if (CacheItem1.ExpiryDate = CacheItem2.ExpiryDate) then
    Result := 0
  else
    Result := -1;
end;
{--------}
function CompareLastUsedDates(const aItem1, aItem2 : pointer) : integer;
var
  CacheItem1 : TCacheItem;
  CacheItem2 : TCacheItem;
begin
  {note: this reverses the usual sense of the comparison so that the
         smallest last-used date (ie the earliest) is retrieved first}
  CacheItem1 := TCacheItem(aItem1);
  CacheItem2 := TCacheItem(aItem2);
  if (CacheItem1.LastUsedDate < CacheItem2.LastUsedDate) then
    Result := 1
  else if (CacheItem1.LastUsedDate = CacheItem2.LastUsedDate) then
    Result := 0
  else
    Result := -1;
end;
{====================================================================}


{===TaaFileCache=====================================================}
constructor TaaFileCache.Create;
begin
  inherited Create;
  {create the containers}
  FItems := TaaHashTableLinear.Create(1021, AAELFHash);
  FExpiryQueue := TaaPriorityQueueEx.Create(CompareExpiryDates);
  FLastUsedQueue := TaaPriorityQueueEx.Create(CompareLastUsedDates);
end;
{--------}
destructor TaaFileCache.Destroy;
begin
  if (FItems <> nil) then begin
    fcSaveToFile;
    Clear;
    FItems.Free;
    FExpiryQueue.Free;
    FLastUsedQueue.Free;
  end;
  inherited Destroy;
end;
{--------}
procedure TaaFileCache.Add(const aExternalName : string;
                           const aExpiryDate   : TDateTime;
                                 aStream       : TStream);
var
  CacheItem    : TCacheItem;
  InternalName : string;
  QualName     : string;
  Stream       : TFileStream;
begin
  {create a unique file name}
  InternalName := fcGetUniqueFileName;
  QualName := fcGetQualifiedFileName(InternalName);
  {create a new cache item}
  CacheItem := nil;
  try
    CacheItem := TCacheItem.Create(InternalName, aExternalName,
                                   aExpiryDate, Now, aStream.Size);
    {try and add the item}
    if not fcAddItem(CacheItem) then begin
      {if it already exists, delete the unique file we created}
      DeleteFile(QualName);
    end
    else
      {otherwise copy the stream over}
      Stream := TFileStream.Create(QualName, fmOpenReadWrite);
      try
        Stream.CopyFrom(aStream, 0);
      finally
        Stream.Free;
      end;
    end;
    {check the maximum disk usage}
    if (FCurDiskSize > MaxDiskSize) then
      fcCleanUp;
  except
    {if a problem occurred, we need to delete the cache item and the
     internal file, and reraise the exception}
    CacheItem.Free;
    DeleteFile(QualName);
    raise;
  end;
end;
{--------}
procedure TaaFileCache.Clear;
var
  i : integer;
begin
  {clear the two queues}
  while (FExpiryQueue.Count > 0) do
    FExpiryQueue.Remove;
  while (FLastUsedQueue.Count > 0) do
    FLastUsedQueue.Remove;
  {clear the hash table}
  for i := 0 to pred(FItems.TableSize) do
    TCacheItem(FItems[i]).Free;
  FItems.Empty;
  {there are no files, hence the disk usage is 0}
  FCurDiskSize := 0;
end;
{--------}
procedure TaaFileCache.Delete(const aExternalName : string);
var
  CacheItem : TCacheItem;
  Handle    : TaaPQHandle;
begin
  {find the cache item for this external name}
  if FItems.Find(aExternalName, pointer(CacheItem)) then begin
    {if the cache item has a data stream, it's in use so we can't
     delete it: raise an exception}
    if (CacheItem.DataStream <> nil) then
      raise Exception.Create('TaaFileCache.Delete: file is in use');
    {delete the cache item from the two queues}
    Handle := CacheItem.ExpiryHandle;
    FExpiryQueue.Delete(Handle);
    Handle := CacheItem.LastUsedHandle;
    FLastUsedQueue.Delete(Handle);
    {delete the item from the hash table}
    FItems.Delete(aExternalName);
    {reduce the total disk usage}
    dec(FCurDiskSize, CacheItem.Size);
    {free the cache item}
    CacheItem.Free;
  end;
end;
{--------}
function TaaFileCache.fcAddItem(aCacheItem : pointer) : boolean;
var
  CacheItem : TCacheItem;
  Dummy     : pointer;
begin
  {typecast the cache item to something recognizable}
  CacheItem := TCacheItem(aCacheItem);
  {make sure it isn't already in the cache, if it is free the passed
   object to make sure we don't have a leak}
  if FItems.Find(CacheItem.ExternalName, Dummy) then begin
    CacheItem.Free;
    Result := false;
    Exit;
  end;
  Result := true;
  {add it to the hash table first}
  FItems.Insert(CacheItem.ExternalName, CacheItem);
  {add it to the expiry queue}
  CacheItem.ExpiryHandle := FExpiryQueue.Add(CacheItem);
  {add it to the lastused queue}
  CacheItem.LastUsedHandle := FLastUsedQueue.Add(CacheItem);
  {increment the disk size}
  inc(FCurDiskSize, CacheItem.Size);
end;
{--------}
procedure TaaFileCache.fcCleanUp;
var
  CacheItem : TCacheItem;
  StaticNow : TDateTime;
begin
  StaticNow := Now;
  {first check our expiry dates}
  CacheItem := FExpiryQueue.Peek;
  while (FCurDiskSize > MaxDiskSize) and
        (CacheItem <> nil) and
        (CacheItem.ExpiryDate < StaticNow) do begin
    Delete(CacheItem.ExternalName);
    CacheItem := FExpiryQueue.Peek;
  end;
  {if we've reduced the disk usage enough, exit}
  if (FCurDiskSize < MaxDiskSize) then
    Exit;
  {now start getting rid of old, not recently used stuff}
  CacheItem := FLastUsedQueue.Peek;
  while (FCurDiskSize > MaxDiskSize) do begin
    Delete(CacheItem.ExternalName);
    CacheItem := FLastUsedQueue.Peek;
  end;
end;
{--------}
function TaaFileCache.fcGetQualifiedFileName(const aFileName : string)
                                                             : string;
begin
  if (Folder = '') then
    raise Exception.Create('No folder defined for cache');
  if (Folder[length(Folder)] <> '\') then
    Result := ExpandFileName(Folder + '\' + aFileName)
  else
    Result := ExpandFileName(Folder + aFileName);
end;
{--------}
function TaaFileCache.fcGetUniqueFileName : string;
var
  TempName : array [0..MAX_PATH] of char;
begin
  {get and create a file with a unique name in the folder}
  if (GetTempFileName(PChar(FFolder), 'AAC', 0, TempName) = 0) then
    RaiseLastWin32Error;
  {return this file name}
  Result := ExtractFileName(StrPas(TempName));
end;
{--------}
procedure TaaFileCache.fcLoadFromFile;
var
  FileStream : TFileStream;
  FileName   : string;
begin
  {get the name of the index file}
  FileName := fcGetQualifiedFileName(CacheFileName);
  {if it doesn't exist, we're starting afresh}
  if not FileExists(FileName) then
    Clear
  {if it does exist, load it}
  else begin
    FileStream := TFileStream.Create(FileName, fmOpenRead);
    try
      fcLoadFromStream(FileStream);
    finally
      FileStream.Free;
    end;
  end;
end;
{--------}
procedure TaaFileCache.fcLoadFromStream(aStream : TStream);
var
  ItemCount : integer;
  i         : integer;
  CacheItem : TCacheItem;
  FileName  : string;
begin
  {clear out the current index}
  Clear;
  {now read the count of items in the stream}
  aStream.ReadBuffer(ItemCount, sizeof(ItemCount));
  {now read in and add all the items}
  for i := 0 to pred(ItemCount) do begin
    CacheItem := TCacheItem.LoadFromStream(aStream);
    FileName := fcGetQualifiedFileName(CacheItem.InternalName);
    if not FileExists(FileName) then
      CacheItem.Free
    else
      fcAddItem(CacheItem);
  end;
end;
{--------}
procedure TaaFileCache.fcSaveToFile;
var
  FileStream : TFileStream;
  FileName   : string;
begin
  {get the name of the index file}
  FileName := fcGetQualifiedFileName(CacheFileName);
  {save the index to this file}
  FileStream := TFileStream.Create(FileName, fmCreate);
  try
    fcSaveToStream(FileStream);
  finally
    FileStream.Free;
  end;
end;
{--------}
procedure TaaFileCache.fcSaveToStream(aStream : TStream);
var
  ItemCount : integer;
  i         : integer;
  CacheItem : TCacheItem;
begin
  {first write out a count of items we have (we'll use the lastused
   list for the count and for the items: it's easier)}
  ItemCount := FLastUsedQueue.Count;
  aStream.WriteBuffer(ItemCount, sizeof(ItemCount));
  {now write out all the items}
  for i := 0 to pred(FItems.TableSize) do begin
    CacheItem := FItems[i];
    if (CacheItem <> nil) then
      CacheItem.SaveToStream(aStream);
  end;
end;
{--------}
procedure TaaFileCache.fcSetFolder(const aName : string);
begin
  if (CompareText(aName, FFolder) <> 0) then begin
    {store the index for the current folder}
    if (Folder <> '') then
      fcSaveToFile;
    {switch folders}
    FFolder := aName;
    {try and read the index for the new folder}
    if (Folder <> '') then
      fcLoadFromFile;
  end;
end;
{--------}
function TaaFileCache.Get(const aExternalName : string) : TStream;
var
  CacheItem : TCacheItem;
  FileStrm  : TFileStream;
  FileName  : string;
begin
  {try and find the cache item in the hash table, if not there, return
   a nil stream}
  if not FItems.Find(aExternalName, pointer(CacheItem)) then begin
    Result := nil;
    Exit;
  end;
  {the item was found, so create a buffered file stream for it}
  FileName := fcGetQualifiedFileName(CacheItem.InternalName);
  FileStrm := TFileStream.Create(FileName, fmOpenRead+fmShareDenyWrite);
  CacheItem.DataStream := TaaBufferedStream.Create(FileStrm, 4096);
  Result := CacheItem.DataStream;
end;
{--------}
procedure TaaFileCache.GetComplete(const aExternalName : string);
var
  CacheItem : TCacheItem;
begin
  {find the cache item for this external name}
  if FItems.Find(aExternalName, pointer(CacheItem)) then begin
    {if the cache item has a data stream...}
    if (CacheItem.DataStream <> nil) then begin
      {free the stream(s)}
      if (CacheItem.DataStream is TaaBufferedStream) then
        TaaBufferedStream(CacheItem.DataStream).Stream.Free;
      CacheItem.DataStream.Free;
      CacheItem.DataStream := nil;
    end;
    {we've just used the cache item, so update its last-used date }
    CacheItem.Use;
    {reprioritize the lsat used date queue for this item}
    FLastUsedQueue.Replace(CacheItem.LastUsedHandle, CacheItem);
  end;
end;
{====================================================================}

end.